VERSION 1.0 CLASS
BEGIN
  MultiUse = 0   'False
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsShowThumb"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const MAX_PATH = 260

Private Type FILETIME
       dwLowDateTime As Long
       dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
       dwFileAttributes As Long
       ftCreationTime As FILETIME
       ftLastAccessTime As FILETIME
       ftLastWriteTime As FILETIME
       nFileSizeHigh As Long
       nFileSizeLow As Long
       dwReserved0 As Long
       dwReserved1 As Long
       cFileName As String * MAX_PATH
       cAlternate As String * 14
End Type

Dim EnablePreview As Boolean
Dim FileName As String
Dim INIPath As String
Dim lstFilesFocus As Boolean

Dim flbList As New Collection

Dim flb As ListView
Dim picSrc As PictureBox
Dim picThumb As PictureBox
Dim imgList As ImageList
Dim stsChoose As StatusBar
Dim stopT As Boolean

Public Sub Imposta() 'ByRef flb1 As ListView, ByRef PicSrc1 As PictureBox, ByRef PicThumb1 As PictureBox, ByRef imgList1 As ImageList, ByRef stsChoose1 As StatusBar)
    Set flb = frmChoose.flb
    Set picSrc = frmChoose.picSrc
    Set picThumb = frmChoose.picThumb
    Set imgList = frmChoose.imgList
    Set stsChoose = frmChoose.stsChoose
End Sub

Public Sub GeneraThumb()
    Dim I As Long
    Dim FN As String
    Dim hHeight As Double, hWidth As Double
    
    For I = flbList.Count To 1 Step -1
        flbList.Remove (I)
    Next
    
    flb.Icons = Nothing
    imgList.ListImages.Clear
    
    flb.ListItems.Clear
    flb.Refresh
    
    GetFiles App.Path & Current_wallpaper_dir 'dlb.Path
    
    For I = flbList.Count To 1 Step -1
        FN = LCase$(Right$(flbList.Item(I), 3))
        If FN <> "jpg" And FN <> "bmp" And FN <> "cur" And FN <> "ico" Then
            flbList.Remove (I)
        End If
    Next
    
    For I = 1 To flbList.Count
        
        If stopT = True Then Exit For
        picSrc.Picture = LoadPicture(flbList(I))
        
        hWidth = picSrc.Width
        hHeight = picSrc.Height
        
        If hHeight > 76.8 Then
            hWidth = 76.8 * picSrc.Width / picSrc.Height
            hHeight = 76.8
        End If
        
        If hWidth > 102.4 Then
            hHeight = 102.4 * picSrc.Height / picSrc.Width
            hWidth = 102.4
        End If
        
        picThumb.PaintPicture picSrc, (picThumb.Width - hWidth) / 2, (picThumb.Height - hHeight) / 2, hWidth, hHeight
        DoEvents
        imgList.ListImages.Add , , picThumb.Image
        If flb.Icons Is Nothing Then flb.Icons = imgList
        flb.ListItems.Add , , GetFileName(flbList(I)), I
        
        picThumb.Cls
        
        stsChoose.Panels(1).Text = "Generating Previews  " & Format(Round(I / flbList.Count * 100, 2), "###.00") & "%"
    Next
    
    flb.Arrange = lvwAutoTop
    stsChoose.Panels(1).Text = flb.ListItems.Count & " items in list"
    'Caption = "Image Browser"
End Sub
'dato un path aggiunge tutti i file immagini all WFD structure
Private Sub GetFiles(Path As String)
   Dim WFD As WIN32_FIND_DATA
   Dim hFile As Long, fPath As String, fName As String
   Dim colFiles As Collection
   Dim varFile As Variant
   
   fPath = AddBackslash(Path)
   fName = fPath & "*.*"
   Set colFiles = New Collection
   
   hFile = FindFirstFile(fName, WFD)
   If (hFile > 0) And ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
       colFiles.Add fPath & StripNulls(WFD.cFileName)
   End If
   
   While FindNextFile(hFile, WFD)
       If ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
           colFiles.Add fPath & StripNulls(WFD.cFileName)
       End If
   Wend
   
   FindClose hFile
   
   For Each varFile In colFiles
       flbList.Add varFile
   Next
   Set colFiles = Nothing
End Sub

'toglie i null da una stringa
Private Function StripNulls(f As String) As String
   StripNulls = Left$(f, InStr(1, f, Chr$(0)) - 1)
End Function

'aggiunge il backslash ad un percorso se server
Private Function AddBackslash(S As String) As String
   If Len(S) Then
      If Right$(S, 1) <> "\" Then
         AddBackslash = S & "\"
      Else
         AddBackslash = S
      End If
   Else
      AddBackslash = "\"
   End If
End Function

'prende il nome di file da un percorso
Private Function GetFileName(File As String) As String
    Dim I As Integer
    For I = Len(File) To 1 Step -1
        If Mid$(File, I, 1) = "\" Then
            I = I + 1
            Exit For
        End If
    Next
    GetFileName = Mid$(File, I)
End Function

Public Property Get stopThumb() As Boolean
    stopThumb = stopT
End Property
Public Property Let stopThumb(ByVal vNewValue As Boolean)
    stopT = vNewValue
End Property
